#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <assert.h>


static int *ma;

#define cccodf FortranName(CCCODF,cccodf)
extern void cccodf (Fchar f_chaine, Fchar f_buffer, const int *lbuffer AddLength (int lf_chaine));

#define envar FortranName(ENVAR,envar)
extern void envar (const char *buffer, Fchar f_str AddLength(int f_str_sz));

#define csleep FortranName(CSLEEP,csleep)
extern void csleep (int *nsec);

/*********************************************************************/
/* function to initialize (former main)                              */
/*********************************************************************/

void FortranName(INITMA,initma) (int *ier)
{

  *ier = 1;
  /* In case of a clever malloc, to be sure to be aligned onto
     8 boundary we allocate at least one double */
  ma = (int *)calloc(1,sizeof(double));
  if (!ma) return;
  *ier = 0;

}

/*********************************************************************/
/* function to get MA inside fortran                                 */
/*********************************************************************/

void FortranName(GETMA,getma) (void **myma)
{
  *myma = (void *)ma;
}

/*********************************************************************/
/* Copie d'un tableau                                                */
/*********************************************************************/

void FortranName(COPYTAB,copytab) (int* srce,int* dest,int* n)
{
    memcpy((void *)dest,(void *)srce,(*n*(sizeof(int))));
}

/*********************************************************************/
/* Zeroing Fortran integer array                                     */
/*********************************************************************/
void FortranName(ZEROI,zeroi) (int* tab,int* n)
{
    memset((void *)tab,0,(*n)*sizeof(int));
}

/*********************************************************************/
/* Zeroing Fortran pointer array                                     */
/*********************************************************************/
void FortranName(ZEROP,zerop) (Pointer* tab,int* n)
{
    memset((void *)tab,0,(*n)*sizeof(Pointer));
}

/*********************************************************************/
/* Zeroing Fortran real array                                        */
/*********************************************************************/
void FortranName(ZEROA,zeroa) (Real* tab,int* n)
{
    memset((void *)tab,0,(*n)*sizeof(Real));
}

/*********************************************************************/
/* resmem                                                           */
/*********************************************************************/
void FortranName(RESMEM,resmem) (int *ptr, Pointer *ioffset, int *lg, int *lgp, int *itype, int *ier)
{

  int lg0;
  ptrdiff_t ishift;

  *ier = 1;
  ishift = ptr - ma;
  if (ishift)
    ptr = (int *)realloc(ptr,(*lg)*sizeof(int));
  else
    ptr = (int *)malloc((*lg)*sizeof(int));
  if (!ptr) return;
  ishift = ptr - ma;
  *ioffset = (Pointer)ishift;
  lg0 = (*lg)-(*lgp);
  if (lg0>0) {
    if (*itype == 1 ) 
      memset((void *)(ptr+*lgp),' ',lg0*sizeof(int));
    else
      memset((void *)(ptr+*lgp),0,lg0*sizeof(int));
  }
  *ier = 0;

}

/*********************************************************************/
/* relmem                                                            */
/*********************************************************************/

void FortranName(RELMEM,relmem) (Pointer *ioffset)
{
  int *ptr;
  ptrdiff_t ishift;

  ptr    = ma+(*ioffset)-1 ;
  ishift = ptr-ma ;
  if (ishift)
    free(ptr);

}

/*********************************************************************/
/* triquicksort                                                      */
/*********************************************************************/

static void triquicksort(int *x, int l, int r)
{
   int   i,j,k,a;

   i=l;j=r;

   a=x[(l+r)/2];

   do
   {
      while (x[i]<a) i++;
      while (a<x[j]) j--;
      if (i<=j)
      {
         k=x[i];x[i]=x[j];x[j]=k;
         i++;j--;
      }
   } while (i<=j) ;

   if (l<j) triquicksort(x,l,j);
   if (i<r) triquicksort(x,i,r);
}

/*********************************************************************/
/* tridir                                                            */
/*********************************************************************/

void FortranName(TRIDIR, tridir) (int *x, int *n)
{
   int N = *n ;

   if (N) triquicksort(x, 0, N-1) ;
}

/*********************************************************************/
/* iquicksortcpl                                                     */
/*********************************************************************/

static void iquicksortcpl(int *x1, int *x2, int l, int r)
{
int   i,j,k,a1,a2;

    i=l;j=r;
    a1=x1[(l+r)/2];
    a2=x2[(l+r)/2];
    do
    {
        while ( (x1[i]<a1) || (x1[i]==a1 && x2[i]<a2) ) i++;
        while ( (a1<x1[j]) || (a1==x1[j] && a2<x2[j]) ) j--;
        if (i<=j)
        {
            k=x1[i];x1[i]=x1[j];x1[j]=k;
            k=x2[i];x2[i]=x2[j];x2[j]=k;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) iquicksortcpl(x1,x2,l,j);
    if (i<r) iquicksortcpl(x1,x2,i,r);
}

/*********************************************************************/
/* tricpl                                                            */
/*********************************************************************/

void FortranName(TRICPL,tricpl) (int* x1,int* x2,int* n)
{
/*int    i,N= *n;*/
int    N= *n;

    if (N!=0) iquicksortcpl(x1,x2,0,N-1);
}

/*********************************************************************/
/* iquicksortcpli                                                    */
/*********************************************************************/

static void iquicksortcpli(int *x1, int *x2, int *ir, int l, int r)
{
int   i,j,k,a1,a2;

    i=l;j=r;
    a1=x1[ir[(l+r)/2]];
    a2=x2[ir[(l+r)/2]];

    do
    {
        while ( (x1[ir[i]]<a1) || (x1[ir[i]]==a1 && x2[ir[i]]<a2) ) i++;
        while ( (a1<x1[ir[j]]) || (a1==x1[ir[j]] && a2<x2[ir[j]]) ) j--;
        if (i<=j)
        {
            k=ir[i];ir[i]=ir[j];ir[j]=k;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) iquicksortcpli(x1,x2,ir,l,j);
    if (i<r) iquicksortcpli(x1,x2,ir,i,r);
}


/*********************************************************************/
/* tricpi                                                            */
/*********************************************************************/

void FortranName(TRICPI,tricpi) (int* x1,int* x2,int* ir,int* n)
{
int    i,N= *n;

    if (N!=0)
    {
        for (i=0;i<N;i++) ir[i]=i;
        iquicksortcpli(x1,x2,ir,0,N-1);
        for (i=0;i<N;i++) ir[i]++;
    }
}

/*********************************************************************/
/* iquicksortcpli2                                                    */
/*********************************************************************/

static void iquicksortcpli2(int *x, int *ir, int l, int r)
{
int   i,j,k,a1,a2;

    i=l;j=r;
    a1=x[2*ir[(l+r)/2]  ];
    a2=x[2*ir[(l+r)/2]+1];

    do
    {
    while ((x[2*ir[i]]<a1) || (x[2*ir[i]]==a1 && x[2*ir[i]+1]<a2)) i++;
    while ((a1<x[2*ir[j]]) || (a1==x[2*ir[j]] && a2<x[2*ir[j]+1])) j--;
        if (i<=j)
        {
            k=ir[i];ir[i]=ir[j];ir[j]=k;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) iquicksortcpli2(x,ir,l,j);
    if (i<r) iquicksortcpli2(x,ir,i,r);
}


/*********************************************************************/
/* tricpi2                                                           */
/*********************************************************************/

void FortranName(TRICPI2,tricpi2) (int* x,int* ir,int* n)
{
int    i,N= *n;

    if (N!=0)
    {
        for (i=0;i<N;i++) ir[i]=i;
        iquicksortcpli2(x,ir,0,N-1);
        for (i=0;i<N;i++) ir[i]++;
    }
}

/*********************************************************************/
/* iquicksort                                                        */
/*********************************************************************/

static void iquicksort(int *x, int *ir, int l, int r)
{
int   i,j,k,a;

    i=l;j=r;
    a=x[ir[(l+r)/2]];

    do
    {
        while (x[ir[i]]<a) i++;
        while (a<x[ir[j]]) j--;
        if (i<=j)
        {
            k=ir[i];ir[i]=ir[j];ir[j]=k;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) iquicksort(x,ir,l,j);
    if (i<r) iquicksort(x,ir,i,r);
}

/*********************************************************************/
/* tri                                                               */
/*********************************************************************/
void FortranName(ILSORT,ilsort)(int* x,int* ir,int* n)

{
int    i,N= *n;

    if (N!=0)
    {
        for (i=0;i<N;i++) ir[i]=i;
        iquicksort(x,ir,0,N-1);
        for (i=0;i<N;i++) ir[i]++;
    }
}

/*********************************************************************/
/* fquicksort                                                        */
/*********************************************************************/
static void fquicksort(Real *x, int *ir, int l, int r)
{
    int  i, j, u ;
    Real a ;

    i=l;j=r;
    a=x[ir[(l+r)/2]];

    do
    {
        while (x[ir[i]]<a) i++;
        while (a<x[ir[j]]) j--;
        if (i<=j)
        {
            u=ir[i];ir[i]=ir[j];ir[j]=u;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) fquicksort(x,ir,l,j);
    if (i<r) fquicksort(x,ir,i,r);
}

/*********************************************************************/
/* ftri                                                              */
/*********************************************************************/

void FortranName(FTRI,ftri) (Real* x,int* ir,int* n)

{
int    i,N= *n;

    if (N!=0)
    {
        for (i=0;i<N;i++) ir[i]=i;
        fquicksort(x,ir,0,N-1);
        for (i=0;i<N;i++) ir[i]++;
    }
}

/*********************************************************************/
/* ftriquicksort                                                     */
/*********************************************************************/

static void ftriquicksort(Real *x, int l, int r)
{
   int   i,j;
   Real a,u;

    i=l;j=r;
    a=x[(l+r)/2];

    do
    {
        while (x[i]<a) i++;
        while (a<x[j]) j--;
        if (i<=j)
        {
            u=x[i];x[i]=x[j];x[j]=u;
            i++;j--;
        }
    } while (i<=j) ;

    if (l<j) ftriquicksort(x,l,j);
    if (i<r) ftriquicksort(x,i,r);
}

/*********************************************************************/
/* ftridirect                                                        */
/*********************************************************************/
void FortranName(FTRIDI,ftridi) (Real* x,int* n)

{
int    N= *n;

    if (N!=0)
    {
        ftriquicksort(x,0,N-1);
    }
}

/*********************************************************************/
/* transfert of fortran string character 2 c                         */
/*********************************************************************/

void cccodf (Fchar f_chaine, Fchar f_buffer, const int *lbuffer AddLength(int lf_chaine))
{
  int max_cars;
  int buff_sz;

  const char *chaine = CharPointer(f_chaine);
  char *buffer = CharPointer(f_buffer);
  int lchaine  = CharLength(f_chaine,lf_chaine);

  buff_sz = (*lbuffer)*sizeof(int);

  max_cars = (buff_sz <= lchaine) ? (buff_sz - 1) : lchaine;
  strncpy(buffer, chaine, max_cars);
  buffer[max_cars] = 0;
}

void envar (const char *buffer, Fchar f_str AddLength(int f_str_sz))
{

  int max_cars;
  char *cp, *str;
  int  cp_sz, str_sz;

  str    = CharPointer(f_str);
  str_sz = CharLength(f_str,f_str_sz);

  cp_sz = 0;
  cp = getenv(buffer);
  if (cp) cp_sz = (int)strlen(cp);

  max_cars = (str_sz <= cp_sz) ? str_sz : cp_sz;
  if (cp) strncpy(str,cp,max_cars);

  /* On remplit avec des blancs... */
  for( ; max_cars < str_sz ; max_cars++ )
    str[max_cars] = ' ';

}

void FortranName(IOSLTYPE,iosltype) (const char *fname, int *iosltype, int *ier)
{
  int i;
  FILE *fp;
  char stream[1],spc[4];
  size_t size;

  *ier = 0;

  spc[0] = 35;
  spc[1] = 36;
  spc[2] = 'V';   //73;
  spc[3] = 'v';  //105;
 
  fp = fopen(fname,"rb");
  if (!fp) {
    *ier = 1;
    return;
  }

  size = sizeof(char);
  fread(stream,size,1,fp);

  *iosltype = 1;
  i = -4;
  do {
    if (stream[0] == spc[4+i]) {
      *iosltype = 0;
      break;
    }
  } while (++i != 0);
 
  fclose(fp);
  fp = 0;
}

void csleep (int *nsec)
{
  unsigned int time;

  time = 1U;
  if (*nsec) time = (unsigned int)*nsec;

/*----------------------------------------------------------------------------*/
/**

  @name          pcstrdup

  @memo          duplicate & return an identical malloc'd string  

  @param         (char *)src

  @return value  (char *)

*/
/*----------------------------------------------------------------------------*/

char * pcstrdup(char *src)
{
  char * result = (char*) malloc((strlen(src)+1)*sizeof(char));

  if (result == NULL)
  {
    printf("     *** ERROR *** MEMORY ALLOCATION IN %s LINE %d\n", __FILE__, __LINE__) ;
    exit(EXIT_FAILURE) ;
  }
  return strcpy(result,src);
}
